Cream of the Crop 26/Cream of the Crop 26.iso/program/p063b9s.zip/UNIT/PARSEREQ.PAS

Pascal/Delphi Source File | 1997-03-02 | 9KB | 317 lines

UNIT ParseReq;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Statemachine to handle file requests          Last changed: 02.03.97  SA ║}
{║                                                                          ║}
{║                         (C) Copyright 1989-97 by                         ║}
{║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
{║                                                                          ║}
{║ This source may not be given to anybody, without the written permission  ║}
{║ from The Portal Team.                                                    ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}

INTERFACE

USES Use32, Dos,
     PoPTypes, NetFile;

TYPE
  ReqTmpVarType=RECORD
    Found : Boolean;
    NextState : Byte;
    ReqTime,
    OKName, ReqName : S20;
    ReqPwd : S80;
    RawReqName, Nfts,
    ReqLine, ReqFileName : PathStr;
    ReqFile, OkFile : TNetFile;
  END;

VAR
  ReqFilesOpen  : Boolean;
  TempSr, ReqSr : SearchRec;

FUNCTION  InitReqFile(Net, Node: Integer): Boolean;
FUNCTION  GetNextFileToSend(VAR FreeArea: TFreeArea): PathStr;
PROCEDURE CloseReqFiles;

IMPLEMENTATION

USES OpCrt, OpDate, OpDos, OpString,
     Globals, Com, FileUtil, UnixDate, MailUtil, StrUtil, PTpl, LogFile,
     Util;

CONST
  Rt : ^ReqTmpVarType = NIL;

FUNCTION InitReqFile(Net, Node: Integer): Boolean;
BEGIN
  New(Rt);
  ReqFilesOpen:=False;
  InitReqFile:=False;
  Rt^.Found:=False;
  RspFile:=HoldFileName(Call,True)+'RSP';

  Rt^.ReqFileName:=MakeReqFileName(Net, Node, GlobNodeStat);
  IF NOT Rt^.ReqFile.OpenWithMode(Rt^.ReqFileName, 1, False, ShareRW+ShareDenyW) THEN
  BEGIN
    CloseReqFiles;
    Exit;
  END;
  IF NOT Rt^.OkFile.Open(StartPath+PoPOkFileName,SizeOf(TOkFile),False) THEN
  BEGIN
    AddLog('!','Can''t open PORTAL.OKF');
    CloseReqFiles;
    Exit;
  END;
  ReqFilesOpen:=True;
  AddLog(' ','NodeStat: '+Long2Str(Ord(GlobNodeStat))+' = Files: '+Long2Str(MaxReqFiles)+
             '  Bytes: '+Long2Str(MaxReqBytes)+
             '  Time: '+TimeToTimeString('hh:mm:ss',MaxReqTime));
  Rt^.NextState:=1;
  InitReqFile:=TRUE;
  StartTime:=CurrentTime;
END;

FUNCTION GetNextFileToSend(VAR FreeArea: TFreeArea): PathStr;
VAR
  OkFileRec : TOkFile;

  PROCEDURE ReadNextReqLine;
  VAR
    s:String;
    i,p:BYTE;
    ch:char;
  BEGIN
    Rt^.OkFile.Seek(0);
    Rt^.Found:=False;
    REPEAT
      Rt^.ReqFile.ReadLine(Rt^.ReqLine) ;
    UNTIL Rt^.ReqFile.EoF OR ((Rt^.ReqLine<>'') AND (Copy(Rt^.ReqLine,1,1)<>';'));
    IF Rt^.ReqFile.EoF AND (Rt^.ReqLine='') THEN
    BEGIN
      Rt^.NextState:=5;
      Exit;
    END;
    Rt^.ReqLine:=StUpCase(Rt^.ReqLine);
    Rt^.ReqName:='';
    Rt^.ReqPwd:='';
    Rt^.ReqTime:='';
    FOR i:=1 TO WordCount(Rt^.reqline, [' ']) DO
    BEGIN
      s:=ExtractWord(i, Rt^.reqline, [' ']);
      Ch:=s[1];
      IF i>1 THEN
      BEGIN
        CASE Ch OF
          '!' : Rt^.reqpwd:=Copy(s, 2, 255);
          '+' : Rt^.reqtime:=Copy(s, 2, 255);
        END;
      END ELSE
        IF Ch<>#0 THEN Rt^.ReqName:=s;
    END;
    IF Rt^.ReqName='' THEN Exit;
    JustFileName(CleanPathName(Trim(Rt^.reqname)));
    Rt^.rawreqname:=Rt^.reqname;
    AddLog('+', 'File Request: `'+Rt^.rawreqname+'''');
    IF Rt^.NextState<>5 THEN
    BEGIN
      Rt^.NextState:=2;
      p:=pos('.', Rt^.reqname);
      IF p>0 THEN
      BEGIN
        Rt^.reqname:=CPad(Copy(Rt^.ReqName,1,p-1), 8)+Pad(Copy(Rt^.reqname, p, 4),4);
        p:=pos('*', Rt^.reqname);
        IF p IN [1..8] THEN
          FOR i:=p TO 8 DO
            Rt^.reqname[i]:='?';
        p:=pos('*', Rt^.reqname);
        IF p > 9 THEN
          FOR i:=p TO 12 DO
            Rt^.reqname[i]:='?';
      END ELSE
        Rt^.ReqName:=CPad(Rt^.ReqName,8)+'.   ';
{
AddLog('*', 'CONVERTED REQ NAME: "'+ReqName+'"');
}
    END;
  END;

  PROCEDURE ReadNextOkLine;
  VAR
    i,p : Byte;
  BEGIN
    Rt^.OkFile.Read(OkFileRec, NoKeep, Wait);
    IF Rt^.OkFile.IoResult<>0 THEN
    BEGIN
      Rt^.NextState:=1;
      IF NOT Rt^.Found THEN
      BEGIN
        ReqSr.Name:=Rt^.rawreqname;
        ReqSr.size:=0;
        ReqSr.Time:=0;
        AddTpl(rspfile,'NOTFOUND', ReqSr);
        AddLog('#','Requested file not found: '+Rt^.RawReqName);
      END;
      Exit;
    END ELSE
    BEGIN
      Rt^.NextState:=3;
      FreeArea:=OkFileRec.FreeArea;
    END;
    IF ((OkFileRec.Password<>'') AND (OkFileRec.Password<>Rt^.reqpwd)) OR (OkFileRec.NodeStat>GlobNodeStat) OR
       (OkFileRec.Level>NodesRec.Level) OR
       ((NodesRec.Keys AND OkFileRec.Keys)<>OkFileRec.Keys) OR
       ((OkFileRec.TaskNumber<>0) AND (OkFileRec.TaskNumber<>Cfg.TaskNumber)) THEN
    BEGIN
      Rt^.NextState:=2;
      Exit;
    END;
    Rt^.OKName:='';
    IF OkFileRec.MagicName='' THEN
    BEGIN
      { normal f.req. }
      okpath:=OkFileRec.FilePath;
      Rt^.OKName:=JustFileName(okpath);
      okpath[0]:=Chr(Length(okpath)-Length(Rt^.OKName)-1);
{
      IF NOT chkdir(okpath) THEN
      BEGIN
        AddLog('!', 'OKFile error: "'+okpath+'" does not exist');
        NextState:=2;
        Exit;
      END;
}
      p:=pos('.', Rt^.OKName);
      IF p=0 THEN
        Rt^.OKName:=CPad(Rt^.OKName,8)+'.   '
      ELSE
        Rt^.OKName:=Pad(Copy(Rt^.OKName, 1, p-1),8)+Pad(Copy(Rt^.OKName, p, 4),4);
      p:=pos('*', Rt^.OKName);
      IF p IN [1..8] THEN
        FOR i:=p TO 8 DO
          Rt^.OKName[i]:='?';
      p:=pos('*', Rt^.OKName);
      IF p > 9 THEN
        FOR i:=p TO 12 DO
          Rt^.OKName[i]:='?';
      FOR i:=1 TO 12 DO
        IF (Rt^.reqname[i]<>'?') AND (Rt^.OKName[i]='?') THEN Rt^.OKName[i]:=Rt^.reqname[i];
    END ELSE
    BEGIN
      { Magic filename }
      IF StUpCase(OkFileRec.MagicName)=StUpCase(Rt^.RawReqName) THEN
      BEGIN
        okpath:=OkFileRec.FilePath;
        Rt^.OKName:=JustFileName(okpath);
        okpath[0]:=Chr(Length(okpath)-Length(Rt^.OKName)-1);
      END ELSE
        Rt^.NextState:=2;
    END;
    Replace(Rt^.OKName, ' ', '', 0);
  END;

  PROCEDURE FindFirstFileToSend;
  VAR
    dt:DateTime;
    reqtimenum,u:LongInt;
    test:WORD;

    FUNCTION HaveJoker(CONST FName: PathStr): Boolean;
    BEGIN
      HaveJoker:=(Pos('*', FName)>0) OR (Pos('?',FName)>0);
    END;

  BEGIN
    FindFirst(OkPath+'\'+Rt^.OKName, Archive+ReadOnly, ReqSr);
    IF DosError<>0 THEN
    BEGIN
      Rt^.NextState:=2;
      IF DOSError=3 THEN AddLog('!', 'OKFile error: "'+okpath+'" does not exist');
    END ELSE
    BEGIN
      Rt^.NextState:=4;
{        IF NOT HaveJoker(RawReqName) AND
           ((OkFileRec.MagicName='') OR NOT HaveJoker(OkFileRec.FilePath)) THEN
          NextState:=1;}
      IF Cfg.Request.SkipAfterFirst THEN
        IF NOT HaveJoker(Rt^.RawReqName) AND (OkFileRec.MagicName='') THEN Rt^.NextState:=1;
      IF Rt^.ReqTime<>'' THEN
      BEGIN
        UnPackTime(ReqSr.Time, Dt);
        WITH Dt DO
          u:=GetUnixDate(Year, Month, Day, Hour, Min, Sec);
        Val(Rt^.reqtime, reqtimenum, test);
      END;
      IF (Rt^.ReqTime='') OR ((Rt^.ReqTime<>'') AND (reqtimenum<u)) THEN
      BEGIN
        Rt^.Nfts:=OkPath+'\'+ReqSr.Name;
        Rt^.Found:=True;
      END;
    END;
  END;

  PROCEDURE FindNextFileToSend;
  VAR
    dt:DateTime;
    reqtimenum,u:LongInt;
    test:WORD;
  BEGIN
    FindNext(ReqSr);
    IF DosError<>0 THEN Rt^.NextState:=2 ELSE
    BEGIN
      Rt^.NextState:=4;
      IF Rt^.reqtime <> '' THEN
      BEGIN
        UnPackTime(ReqSr.Time, Dt);
        WITH Dt DO
          u:=GetUnixDate(Year, Month, Day, Hour, Min, Sec);
        Val(Rt^.reqtime, reqtimenum, test);
      END;
      IF (Rt^.reqtime='') OR ((Rt^.ReqTime<>'') AND (ReqTimeNum<u)) THEN
      BEGIN
        Rt^.Nfts:=OkPath+'\'+ReqSr.Name;
        Rt^.Found:=True;
      END;
    END;
  END;

BEGIN
  Rt^.nfts:='';
  doserror:=0;
  IF ExistFile(Rt^.ReqFileName) THEN
  BEGIN
    REPEAT
      CASE Rt^.NextState OF
        1 : ReadNextReqLine;
        2 : ReadNextOkLine;
        3 : FindFirstFileToSend;
        4 : FindNextFileToSend;
      END;
    UNTIL (Rt^.NextState=5) OR (Rt^.nfts<>'') OR NOT ComPort^.Carrier;
  END;
  GetNextFileToSend:=Rt^.nfts;
  IF (Rt^.nfts='') OR NOT ComPort^.Carrier THEN CloseReqFiles;
END;

  PROCEDURE CloseReqFiles;
  BEGIN
    FindClose(ReqSr);
    IF ReqFilesOpen THEN
    BEGIN
      Rt^.ReqFile.Close;
      DeleteFile(Rt^.ReqFileName);
      Rt^.OkFile.Close;
      ReqFilesOpen:=False;
    END;
    IF Rt<>NIL THEN
    BEGIN
      Dispose(Rt);
      Rt:=NIL;
    END;
  END;

BEGIN
  ReqFilesOpen:=False;
END.